rm(list = ls())
setwd("~/Projects/news_tweets")
## --- Load Packages --- ##
library(rtweet)
library(dplyr)
library(ggplot2)
library(rvest)
library(tidyr)
library(wordcloud2)
library(igraph)
library(ggraph)
library(stringr)
library(tm)
library(tidytext)
library(stringi)
library(lubridate)

## --- Set Stylings --- ###
knitr::opts_chunk$set(message=FALSE, warning=FALSE)

theme_set(
  theme_bw(base_size = 14) +
    theme(
      plot.title = element_text(face = "bold", size = 14, 
                                margin = margin(0, 0, 4, 0, "pt")),
      plot.subtitle = element_text(size = 12),
      plot.caption = element_text(size = 6, hjust = 0),
      axis.title = element_text(size = 10),
      panel.border = element_blank()
    )
)

## --- Global Variables --- ##
# Define Color
Mycol <- RColorBrewer::brewer.pal(8, "Dark2")

# Define http pattern
http <- paste("http.*","https.*", sep = "|")

# Define Stopwords
stopwords <- data_frame(
  word =  stopwords("german")
) %>% rbind(
  data_frame(word = c("t.co","via","mal","dass","mehr", "amp","https",
                      "beim", "ab","sollen","ganz","sagt",
                      "schon","rt","gibt", "ja", "natürlich"))
)

Deutschsprachige Tweets die den Hashtag “#GERSWE” beinhalten. Die Tweets wurden mit Hilfe des R Packetes rtweet über die REST API ausgelesen. Der gesamte Code ist hier einzusehen.

Folgende Variablen sind in unserem Datensatz vorhanden.

load("../../data/germex.Rda")
attr(rt$created_at, "tzone") <- "Europe/Berlin"

start <- as.POSIXct("2018-06-17 16:00", tz = "Europe/Berlin")
end <- start + minutes(220)

gamestart <- as.POSIXct("2018-06-17 17:00", tz = "Europe/Berlin")
gameend <- gamestart + minutes(112)

rt_small <- rt %>% 
#  mutate(created_at = as.POSIXct(created_at + hours(2))) %>%
  filter(created_at >= start) %>%
  filter(created_at <= end) 

Zeitraum

rt_small %>%
  ts_plot("1 minute",
        color = Mycol[3]) +
  geom_vline(xintercept = gamestart, color=Mycol[1], linetype = 2) +
  geom_vline(xintercept = gameend, color=Mycol[1], linetype = 2) +
  theme(plot.title = element_text(face = "bold"),
        axis.text.x = element_blank()) +
  labs(
    x = NULL, y = NULL,
    title = "Tweets zum Spiel Deutschland - Mexiko",
    subtitle = paste("Zeitraum:",min(rt$created_at),"bis",max(rt$created_at))
  ) 

Retweets

Welche Tweets wurden am häufigsten geteilt? Die top 10 sind:

rt_small %>%
  filter(is_retweet == FALSE ) %>%
  dplyr::select(screen_name, text, retweet_count) %>%
  group_by(screen_name, text) %>%
  summarise(retweet_count = sum(retweet_count)) %>%
  arrange(desc(retweet_count)) %>%
  .[1:10,] %>%
  #knitr::kable(align = "l")
  htmlTable::htmlTable(align="l")
screen_name text retweet_count
1 DFB_Team Schluss! #DieMannschaft verliert den WM-Auftakt gegen Mexiko. #GERMEX 0-1 #ZSMMN https://t.co/wE73FNLBrv 1356
2 ThatRexGuy Joachim Löw when literally anything happens. #GERMEX #WorldCup https://t.co/5e0xQ9Q3Yy 1172
3 KuehniKev Sportminister ist in #Deutschland übrigens Horst Seehofer. 🤷🏼‍♂️ #GERMEX 906
4 DerWachsame Wir haben ein Fußballspiel verloren, das ist traurig, aber nicht schlimm. Morgen wird vielleicht ein durchgeknallter Innenminister im Alleingang die Grenzen schließen und die Regierung sprengen. DAS ist schlimm. #GERMEX 801
5 ghensel Mal im Ernst. Rausfliegen in der Vorrunde passt doch bombe zu unserer masochistischen Gefühlslage gerade. Ich sehe schon die Talkshow-Themen vor mir: „Deutsches WM-Aus. Welche Rolle spielt der Islam?“ #GERMEX 499
6 DFB_Team Seid ihr bereit für #GERMEX 🇩🇪🇲🇽? #ZSMMN #WM2018 #GERMEX https://t.co/POxvqBKDBj 491
7 DFB_Team Auf geht’s, Männer!!! 🇩🇪🇲🇽 #ZSMMN #WM2018 #GERMEX 0-0 https://t.co/l13goZrece 470
8 DFB_Team Halbzeit. Mund abputzen. Da geht noch was, Männer! #GERMEX 0-1 #DieMannschaft #ZSMMN https://t.co/0ZJu1R64iL 443
9 OomenBerlin

Seit wir Nazis im Bundestag haben hat die #Nationalmannschaft noch kein WM-Spiel gewonnen. Denkt mal drüber nach.

#GERMEX #WM2018
440
10 FCBayern

🇩🇪 Kopf hoch, Männer! #WeiterImmerWeiter

#GERMEX #DieMannschaft #WM2018 https://t.co/CLHAah2jJo
431

Wordcloud

rt_clean <- rt_small %>%
  # First, remove http elements manually
  mutate(stripped_text = gsub(http,"", text)) %>%
  mutate(stripped_text = gsub("germex","", text, ignore.case = T)) 
  
rt_tidy_words <- rt_clean %>%
  # Second, remove punctuation, convert to lowercase, add id for each tweet!
  dplyr::select(stripped_text) %>%
  unnest_tokens(word, stripped_text) %>%
  
  # Third, remove stop words from your list of words 
  anti_join(stopwords) %>%
  
  # Count Word occurences in a tweet
  count(word, sort = TRUE) 

rt_tidy_words %>%
  wordcloud2(size = 3, 
           color = "random-light", backgroundColor = "grey")

Wie sind die Wörter miteinander verlinkt?

word_network(rt_clean)

Sentiment Analyse

SentimentWortschatz, or SentiWS for short, is a publicly available German-language resource for sentiment analysis, opinion mining etc. It lists positive and negative polarity bearing words weighted within the interval of [-1; 1] plus their part of speech tag, and if applicable, their inflections. The current version of SentiWS (v1.8b) contains 1,650 positive and 1,818 negative words, which sum up to 15,649 positive and 15,632 negative word forms incl. their inflections, respectively. It not only contains adjectives and adverbs explicitly expressing a sentiment, but also nouns and verbs implicitly containing one.

sent <- c(
  # positive Wörter
  readLines("../../dict/SentiWS_v1.8c_Negative.txt",
            encoding = "UTF-8"),
  # negative Wörter
  readLines("../../dict/SentiWS_v1.8c_Positive.txt",
            encoding = "UTF-8")
) %>% lapply(function(x) {
  # Extrahieren der einzelnen Spalten
  res <- strsplit(x, "\t", fixed = TRUE)[[1]]
  return(data.frame(words = res[1], value = res[2],
                    stringsAsFactors = FALSE))
}) %>%
  bind_rows %>% 
  mutate(word = gsub("\\|.*", "", words) %>% tolower,
         value = as.numeric(value)) %>%
  # manche Wörter kommen doppelt vor, hier nehmen wir den mittleren Wert
  group_by(word) %>% summarise(value = mean(value)) %>% ungroup
sentDF <- rt_clean %>%
  # Second, remove punctuation, convert to lowercase, add id for each tweet!
  unnest_tokens(word, stripped_text) %>%
  left_join(., sent, by="word") %>% 
  mutate(value = as.numeric(value)) %>% 
  #filter(!is.na(value)) %>%
  mutate(negative = ifelse(value < 0, value, NA),
         positive = ifelse(value > 0, value, NA),
         negative_d = ifelse(value < 0, 1, 0),
         positive_d = ifelse(value > 0, 1, 0)) 

Wordclouds

Positive Wörter

Negative wörter

Top 10 positive Tweets

sentDF.grouped <- sentDF %>%
  group_by(status_id) %>%
  summarise(mean_value = mean(value, na.rm = T),
            sum_value = sum(value, na.rm = T),
            positive = sum(positive, na.rm = T),
            negative = sum(negative, na.rm = T)) %>%
  left_join(., rt_small %>% dplyr::select(status_id, screen_name, text, created_at),
            by = "status_id") %>%
  filter(!is.na(mean_value))

sentDF.grouped %>%
  arrange(desc(mean_value)) %>%
  select(screen_name, text, mean_value, created_at) %>%
  .[1:10,] %>%
  htmlTable::htmlTable(align="l")
screen_name text mean_value created_at
1 Hessenfriese @BILD Ist uns fast gelungen….. #GERMEX #WM2018 https://t.co/quDq0wTnMX 1 2018-06-17 17:01:12
2 Mastermind_09 Draxler und Reus bislang ungefähr mit gleich vielen gelungen Ballaktionen. #GERMEX 1 2018-06-17 17:22:02
3 GmachtZumTxtn Noch nie ist es einer Mannschaft gelungen seinen eigenen Linksverteidiger so aus dem Spiel zu nehmen #GERMEX 1 2018-06-17 18:37:26
4 nerdfromaustria Der Sonntag wäre perfekt, wenn Deutschland eins auf die Nase kriegt… Ganz neutral gesprochen ;) #GERMEX #WM2018 0.7299 2018-06-17 16:12:47
5 DerFilmer That feel wenn der @BR24 Radiokommentar perfekt synchron zum @BBCSport Fernsehbild ist. #GERMEX #WM2018 0.7299 2018-06-17 17:11:25
6 mir70 Kimmich passt vom Sympathiefaktor perfekt zum FC Bayern … #GERMEX 0.7299 2018-06-17 17:26:16
7 nerow1909 @Endi_AJ Wer gerade mal seinen lamborghini ausfahren will, kann das gerade perfekt tun. Auch in der kölner innenstadt. #germex 0.7299 2018-06-17 17:31:51
8 Sarpei007 Naja. Die Taktik von Mex ist halt perfekt gegen die immergleiche Aufstellung/Taktik von uns. #GERMEX 0.7299 2018-06-17 17:46:21
9 allo_morph Ich nutze auch perfekt die Räume. Im Schlafzimmer schlafe ich, im Wohnzimmer wohne ich, im Badezimmer dusche ich…och Menno! #GERMEX 0.7299 2018-06-17 17:54:25
10 hassanscorner Man muss aber auch sagen, dass der Testspielgegner Saudi-Arabien die Mexikaner perfekt simuliert hat. #GERMEX 0.7299 2018-06-17 17:54:43

Top 10 negative Tweets

sentDF.grouped %>%
  arrange(mean_value) %>%
  select(screen_name, text, mean_value, created_at) %>%
  .[1:10,] %>%
  htmlTable::htmlTable(align="l")
screen_name text mean_value created_at
1 DieMone37 Neuer wird nicht in die Gefahr kommen einzuschlafen. #WM2018 #GERMEX -1 2018-06-17 17:02:47
2 hyouhakuhunter

Deine Meinungsfreiheit ist in Gefahr!

@fckart13 #FCKArt13 #GERMEX #WM2018 https://t.co/h8XhRv1Adu
-1 2018-06-17 17:04:02
3 sirxwastaken

Das Internet ist in Gefahr und ihr habt nur Augen für einen Ball.

Schaut wenigstens in der Halbzeit mal vorbei und informiert euch!

https://t.co/QujMbEK3E1

#GERMEX #fckart13 #WM2018 #ger #mex #DieMannschaft
-1 2018-06-17 17:04:22
4 sportwetten_de
  1. Min., 0:0: Aber auch Mexikos Freistöße sind eher eine Bewerbung für Fieldgoals beim Football als eine Gefahr für Manuel Neuer. #swde #GERMEX #liveticker #WM2018
-1 2018-06-17 17:10:31
5 Baumbart4Z0 Das freie Internet ist in Gefahr! #WM2018 #FCKArt13 #GERMEX https://t.co/lmKRfYI6bK -1 2018-06-17 17:13:00
6 anjaSeeBR Am 20/21.06 stimmt das EUparlament über Artikel 13 ab. Memes, Videos, Remixe, Parodien, Zitate sind in Gefahr #Meinungsfreiheit

Informier dich: https://t.co/KhlVEENOXh

#GERMEX #WM2018 #savetheinternet #FCKArt13 #SaveOurInternet
-1 2018-06-17 17:20:59
7 Winkendekatze

SCHAUT NICHT WEG! Das Internet ist in Gefahr!

WM2018

GERMEX

#FCKart13 https://t.co/SLDh8eSEav
-1 2018-06-17 17:22:28
8 Jan_04 Teilweise vogelwild - auf beiden Seiten. An sich mal ein ganz angenehmer Kontrast zum kontrollierten Fußball in der Bundesliga. Birgt aber die Gefahr, dass beim Abpfiff 80 Millionen Deutsche Boatengs Haarfarbe haben. #GERMEX #WM2018 -1 2018-06-17 17:23:29
9 marcelbuslay Am 20. Juni 2018 wird über Artikel 13 abgestimmt. Helft mit das Zensurgesetzt zu verhindern bevor es zu spät ist. Informiere dich jetzt: https://t.co/JeRueO11zn Deine Meinungsfreiheit ist in Gefahr! #FCKArt13 #savetheinternet #saveyourinternet #GERMEX https://t.co/7a1DQSsj6h -1 2018-06-17 17:25:20
10 Kwn69943344

Das Internet ist in Gefahr! Informier dich! #WM2018 #GERMEX #FCKart13

https://t.co/zmDr4x4lxM https://t.co/6wbQTu4ybH
-1 2018-06-17 17:28:54
sentDF.grouped %>%
  mutate(time = as.POSIXct(substr(created_at,1,16))) %>%
  group_by(time) %>%
  summarise(mean_value = mean(mean_value)) %>%
  ggplot() +
  geom_line(aes(time, mean_value),
             color = Mycol[3]) +
  geom_vline(xintercept = gamestart, color = Mycol[2], linetype = 2) +  
  geom_vline(xintercept = gameend, color = Mycol[2], linetype = 2) +
  labs(y = "", x="", title = "Durchschnittlicher Sentiment Wert")